home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 10
/
FM Towns Free Software Collection 10.iso
/
ms_dos
/
lib
/
happysrc
/
pcgencd.c
< prev
next >
Wrap
Text File
|
1994-11-14
|
24KB
|
634 lines
/***************************************
* *
* ** HAPPy Pascal compiler ** *
* P-code ソース生成 *
* *
* Copyright (c) H.Asano 1992-1994. *
***************************************/
#define EXTERN extern
#include <stdio.h>
#include "pascomp.h"
#include "pcpcd.h"
extern char *version ; /* HAPPyのバージョン番号 */
extern FILE *pcdfile ; /* Pコード出力ファイル */
/***** function prototype *****/
extern void pcerr(int,char*) ;
extern boolean string(stp*) ;
extern void getbounds(stp*,long*,long*) ;
extern void term(void) ;
/********** P-code ニーモニック 定義表 **********/
static struct {
char *mn ; /* P-code mnemonics */
short cdx ; /* stack pointerの動き */
} icd[iZZZ] ;
/***************************************/
/* initpcd() : P-code関連 初期設定処理 */
/***************************************/
void initpcd(void)
{
/*enum pcdmnc i ;*/
/**** P-code instruction mnmonics の 登録 *****/
/* for(i=iABI;i<iZZZ;i++) icd[i].cdx = 0 ;*//* staticなので初期化済*/
icd[iABI].mn = "abi" ;
icd[iABR].mn = "abr" ;
icd[iADI].mn = "adi" ; icd[iADI].cdx =-1 ;
icd[iADR].mn = "adr" ; icd[iADR].cdx =-1 ;
icd[iAND].mn = "and" ; icd[iAND].cdx =-1 ;
icd[iATN].mn = "atn" ;
icd[iBAS].mn = "bas" ; icd[iBAS].cdx =+1 ;
icd[iCHK].mn = "chk" ;
icd[iCHR].mn = "chr" ;
icd[iCKA].mn = "cka" ;
icd[iCOS].mn = "cos" ;
icd[iCUI].mn = "cui" ; icd[iCUI].cdx =-1 ;
icd[iCUP].mn = "cup" ;
icd[iDEC].mn = "dec" ;
icd[iDIF].mn = "dif" ; icd[iDIF].cdx =-1 ;
icd[iDIS].mn = "dis" ; icd[iDIS].cdx =-1 ;
icd[iDVI].mn = "dvi" ; icd[iDVI].cdx =-1 ;
icd[iDVR].mn = "dvr" ; icd[iDVR].cdx =-1 ;
icd[iEJP].mn = "ejp" ;
icd[iENT].mn = "ent" ;
icd[iEOF].mn = "eof" ;
icd[iEOL].mn = "eol" ;
icd[iEQU].mn = "equ" ; icd[iEQU].cdx =-1 ;
icd[iEXP].mn = "exp" ;
icd[iFJP].mn = "fjp" ; icd[iFJP].cdx =-1 ;
icd[iFLO].mn = "flo" ;
icd[iFLT].mn = "flt" ;
icd[iGEQ].mn = "geq" ; icd[iGEQ].cdx =-1 ;
icd[iGET].mn = "get" ; icd[iGET].cdx =-1 ;
icd[iGRT].mn = "grt" ; icd[iGRT].cdx =-1 ;
icd[iINC].mn = "inc" ;
icd[iIND].mn = "ind" ;
icd[iINN].mn = "inn" ; icd[iINN].cdx =-1 ;
icd[iINT].mn = "int" ; icd[iINT].cdx =-1 ;
icd[iIOR].mn = "ior" ; icd[iIOR].cdx =-1 ;
icd[iIXA].mn = "ixa" ; icd[iIXA].cdx =-1 ;
icd[iLAO].mn = "lao" ; icd[iLAO].cdx =+1 ;
icd[iLAP].mn = "lap" ; icd[iLAP].cdx =+1 ;
icd[iLCA].mn = "lca" ; icd[iLCA].cdx =+1 ;
icd[iLDA].mn = "lda" ; icd[iLDA].cdx =+1 ;
icd[iLDC].mn = "ldc" ; icd[iLDC].cdx =+1 ;
icd[iLDO].mn = "ldo" ; icd[iLDO].cdx =+1 ;
icd[iLEQ].mn = "leq" ; icd[iLEQ].cdx =-1 ;
icd[iLES].mn = "les" ; icd[iLES].cdx =-1 ;
icd[iLOD].mn = "lod" ; icd[iLOD].cdx =+1 ;
icd[iLOG].mn = "log" ;
icd[iMMS].mn = "mms" ; icd[iMMS].cdx =-1 ;
icd[iMOD].mn = "mod" ; icd[iMOD].cdx =-1 ;
icd[iMOV].mn = "mov" ; icd[iMOV].cdx =-2 ;
icd[iMPI].mn = "mpi" ; icd[iMPI].cdx =-1 ;
icd[iMPR].mn = "mpr" ; icd[iMPR].cdx =-1 ;
icd[iMSI].mn = "msi" ; icd[iMSI].cdx =-1 ;
icd[iMST].mn = "mst" ;
icd[iNEQ].mn = "neq" ; icd[iNEQ].cdx =-1 ;
icd[iNEW].mn = "new" ; icd[iNEW].cdx =-1 ;
icd[iNGI].mn = "ngi" ;
icd[iNGR].mn = "ngr" ;
icd[iNOT].mn = "not" ;
icd[iNXT].mn = "nxt" ;
icd[iNXD].mn = "nxd" ;
icd[iODD].mn = "odd" ;
icd[iORD].mn = "ord" ;
icd[iPGE].mn = "pge" ; icd[iPGE].cdx =-1 ;
icd[iPUT].mn = "put" ; icd[iPUT].cdx =-1 ;
icd[iRDC].mn = "rdc" ; icd[iRDC].cdx =-2 ;
icd[iRDI].mn = "rdi" ; icd[iRDI].cdx =-2 ;
icd[iRDR].mn = "rdr" ; icd[iRDR].cdx =-2 ;
icd[iRET].mn = "ret" ;
icd[iRLN].mn = "rln" ; icd[iRLN].cdx =-1 ;
icd[iROU].mn = "rou" ;
icd[iRST].mn = "rst" ; icd[iRST].cdx =-1 ;
icd[iRWT].mn = "rwt" ; icd[iRWT].cdx =-1 ;
icd[iSBI].mn = "sbi" ; icd[iSBI].cdx =-1 ;
icd[iSBR].mn = "sbr" ; icd[iSBR].cdx =-1 ;
icd[iSGS].mn = "sgs" ;
icd[iSIN].mn = "sin" ;
icd[iSQI].mn = "sqi" ;
icd[iSQR].mn = "sqr" ;
icd[iSQT].mn = "sqt" ;
icd[iSRO].mn = "sro" ; icd[iSRO].cdx =-1 ;
icd[iSTO].mn = "sto" ; icd[iSTO].cdx =-2 ;
icd[iSTP].mn = "stp" ;
icd[iSTR].mn = "str" ; icd[iSTR].cdx =-1 ;
icd[iTGT].mn = "tgt" ; icd[iTGT].cdx =-1 ;
icd[iTPT].mn = "tpt" ; icd[iTPT].cdx =-1 ;
icd[iTRA].mn = "tra" ;
icd[iTRC].mn = "trc" ;
icd[iTRS].mn = "trs" ; icd[iTRS].cdx =-1 ;
icd[iTRW].mn = "trw" ; icd[iTRW].cdx =-1 ;
icd[iUJC].mn = "ujc" ;
icd[iUJP].mn = "ujp" ;
icd[iUNI].mn = "uni" ; icd[iUNI].cdx =-1 ;
icd[iWLN].mn = "wln" ; icd[iWLN].cdx =-1 ;
icd[iWRB].mn = "wrb" ; icd[iWRB].cdx =-3 ;
icd[iWRC].mn = "wrc" ; icd[iWRC].cdx =-3 ;
icd[iWRF].mn = "wrf" ; icd[iWRF].cdx =-4 ;
icd[iWRI].mn = "wri" ; icd[iWRI].cdx =-3 ;
icd[iWRR].mn = "wrr" ; icd[iWRR].cdx =-3 ;
icd[iWRS].mn = "wrs" ; icd[iWRS].cdx =-3 ;
icd[iXJP].mn = "xjp" ; icd[iXJP].cdx =-1 ;
}
/****************************************/
/* errchk() : P-codeソースファイルへの */
/* 出力でエラーがあったか */
/* 調べる */
/****************************************/
static void errchk(int returnfprintf)
{
if(returnfprintf == EOF) {
pcerr(701,"") ;
term() ; /* 終了処理 */
}
}
/**********************************/
/* mes(): スタックの必要量を調べる*/
/* --> topmax */
/**********************************/
static void mes(int i)
{
topnew += icd[i].cdx*maxstack ;
if(topnew > topmax) topmax = topnew ;
ic++ ; /* Instruction Counter 更新 */
}
/***************************************/
/* putic() : P-CODE付加情報出力 */
/* ソースの行番号を出力する */
/***************************************/
static void putic(void)
{
static oldlineno = 0;
if(! pcdinf) return ; /* P-code information off の時*/
if(oldlineno != lineno) {
oldlineno = lineno ;
errchk(fprintf(pcdfile,"; %s(%d)\n",passname,lineno)) ;
/* ソースファイル名、行番号出力*/
}
}
/************************************************/
/* gentypindicator(): 型名の出力 */
/* i : integer & 列挙型 */
/* b : boolean */
/* c : char r : real */
/* a : pointer s : set */
/* m : records & arrays */
/************************************************/
static void gentypindicator(stp *fsp)
{
char *type ;
if(fsp)
switch(fsp->form) {
case subrange : /* 範囲型 */
gentypindicator(fsp->sf.su.rangetype);/* 基の型について調べる*/
return ; /* 戻る */
case scalar : /* スカラー型 */
if(fsp == intptr) type = "i" ;
else if (fsp == boolptr) type = "b" ;
else if (fsp == charptr) type = "c" ;
else if (fsp->sf.sc.scalkind == declared) type = "i" ;
else type = "r" ;
break ;
case pointer : /* ポインタ型 */
type = "a" ;
break ;
case power : /* 集合型 */
type = "s" ;
break ;
case records : /* レコード */
case arrays : /* 配列 */
type = "m" ;
break ;
/* case files : */
/* case tagfld : */
/* case variant : */
/* このルートへ来てはいけない */
}
else type = " " ; /* 型がない時 空白を出力 */
errchk(fprintf(pcdfile,type)) ;
}
/***************************************/
/* crelabel() :ラベル値の生成 */
/***************************************/
int crelabel(void)
{
static int labelvalue = 0 ;
return(++labelvalue) ;
}
/**************************************/
/* putlabel(): ラベルの出力 */
/**************************************/
void putlabel(int labname)
{
if(!pcode) return ; /* 出力不要ならリターン */
errchk(fprintf(pcdfile,"L%d\n",labname)) ;
}
/****************************************/
/* putentv(): ent命令のオペランド値出力 */
/****************************************/
void putentv(int p, int q)
{
if(!pcode) return ; /* 出力不要ならリターン */
errchk(fprintf(pcdfile,"V %4d %4d\n", p, q)) ;
}
/**************************************/
/* putprogname(): プログラム名の出力 */
/**************************************/
void putprogname(char *progname)
{
if(!pcode) return ; /* 出力不要ならリターン */
errchk(fprintf(pcdfile,
"; Writen by HAPPy Pascal Compiler Version %s\n; source file=%s\nN %s\n",
version,passname,progname));
}
/**************************************/
/* putfilename(): ファイル名の出力 */
/* F ファイル名 アドレス サイズ */
/**************************************/
void putfilename(char *name, int adr,int size)
{
if(!pcode) return ; /* 出力不要ならリターン */
putic() ;
errchk(fprintf(pcdfile,"F %s %5d %5d\n", name,adr,size));
}
/**************************************/
/* putq(): quit指示の出力 */
/**************************************/
void putq(void)
{
if(!pcode) return ; /* 出力不要ならリターン */
errchk(fprintf(pcdfile,"Q\n"));
}
/***************************************/
/* putmnc() : ニーモニック出力処理 */
/***************************************/
static void putmnc(enum pcdmnc fop)
{
putic() ; /* 行番号出力 */
errchk(fprintf(pcdfile," %s",icd[fop].mn)) ; /* ニーモック出力 */
mes(fop) ; /* sp増減値更新 */
}
/**************************************/
/* gen0(): オペランドのないP-code出力 */
/**************************************/
void gen0(enum pcdmnc fop)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
errchk(fprintf(pcdfile,"\n")) ;
}
/************************************************/
/* genp(): パラメータがpで、 型のないP-code出力 */
/************************************************/
void genp(enum pcdmnc fop, int fp)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
errchk(fprintf(pcdfile,"%4d\n",fp)) ;
}
/************************************************/
/* genq(): パラメータがqで、 型のないP-code出力 */
/************************************************/
void genq(enum pcdmnc fop, int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
errchk(fprintf(pcdfile,"%12d\n",fq)) ;
}
/*************************************************/
/* gen0t() : パラメータがなくて型名のある命令 */
/* の出力 */
/*************************************************/
void gen0t(enum pcdmnc fop,stp *fsp)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
gentypindicator(fsp) ; /* 型の出力 */
errchk(fprintf(pcdfile,"\n")) ;
}
/************************************************/
/* gen1t() : パラメータ1つで型名のある命令 */
/* の出力 */
/************************************************/
void gen1t(enum pcdmnc fop,stp *fsp, int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
gentypindicator(fsp) ; /* 型の出力 */
errchk(fprintf(pcdfile,"%11d\n",fq)) ;
}
/************************************************/
/* gen2t() : パラメータが2つで型名のある命令 */
/* の出力 */
/************************************************/
void gen2t(enum pcdmnc fop, stp *fsp, int fp,int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
gentypindicator(fsp) ; /* 型の出力 */
errchk(fprintf(pcdfile," %2d %7d\n",fp,fq)); /* p と q の出力 */
}
/************************************************/
/* genent(): ent命令の出力 */
/************************************************/
void genent(void)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(iENT) ;
errchk(fprintf(pcdfile," V\n")) ;
}
/************************************************/
/* genret(): ret命令の出力 */
/************************************************/
void genret(stp *fsp)
{
if(!pcode) return ; /* 出力不要ならリターン */
if(fsp) gen0t(iRET,fsp) ; /* 型に応じたret命令 */
else { /* 型がない時 */
putmnc(iRET) ;
errchk(fprintf(pcdfile, "p\n")) ; /* retp命令 */
}
}
/************************************************/
/* genlca(): lca命令の出力 */
/* lca '文字列'\n */
/************************************************/
static void genlca(void)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(iLCA) ;
errchk(fprintf(pcdfile, " '%s'\n",gattr.cval.valp->c.sval)) ;
}
/************************************************/
/* genlda(): lda命令の出力 */
/* lda p q */
/************************************************/
void genlda(int fp,int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(iLDA) ;
errchk(fprintf(pcdfile, " %3d %7d\n", fp, fq));
}
/************************************************/
/* genixa(): ixa命令の出力 */
/* ixa p q */
/************************************************/
void genixa(long fp,int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(iIXA) ;
errchk(fprintf(pcdfile, " %3ld %7d\n", fp, fq));
}
/***************************************************/
/* genldc(): ldc命令の出力 */
/* ldci q 整数値をスタックにのせる */
/* ldcr ・・・.・・・ 実数値をスタックにのせる */
/* ldcb q boolean値をスタックのせる */
/* ldcn nilをスタックにのせる */
/* ldcc 'q' 文字をスタックにのせる */
/* ldcs (・ ・ ・) 集合の要素をスタックにのせる*/
/***************************************************/
void genldc(char ftype,long fq)
{
int i ;
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(iLDC) ;
switch(ftype) {
case 'i' :
case 'b' : errchk(fprintf(pcdfile,"%c %10ld\n",ftype,fq)) ;
break ;
case 'r' : errchk(fprintf(pcdfile,"r %s\n",gattr.cval.valp->c.rval)) ;
break ;
case 'n' : errchk(fprintf(pcdfile,"n\n")) ; /* fqはない */
break ;
case 'c' : errchk(fprintf(pcdfile,"c '%c'\n",(char)fq)) ;
break ;
case 's' : errchk(fprintf(pcdfile,"s (")) ;
for(i=0; i<=sethigh; i++)
if((gattr.cval.valp->c.pval >> i) & 0x1) /* 要素あり*/
errchk(fprintf(pcdfile,"%3d",i)) ;
errchk(fprintf(pcdfile,")\n")) ;
}
}
/************************************************/
/* gencupejp(): cup, ejp命令の出力 */
/* cup 引数の数 手続きのラベル */
/* ejp 水準差 ラベル */
/************************************************/
void gencupejp(enum pcdmnc fop, int fp1, int fp2)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
errchk(fprintf(pcdfile," %3d L%4d\n", fp1, fp2 )) ;
}
/************************************************/
/* genjump(): jump関係の命令出力 */
/* ujp / fjp */
/************************************************/
void genjump(enum pcdmnc fop, int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
errchk(fprintf(pcdfile," L%4d\n", fq)) ;
}
/************************************************/
/* gencompare(): 比較関係の命令出力 */
/* les/leq/grt/geq/neq/equ */
/************************************************/
void gencompare(enum pcdmnc fop, char ftypind,int fq)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(fop) ;
if(ftypind == 'm') /* 文字列比較 */
errchk(fprintf(pcdfile,"m%11d\n",fq)) ; /* 比較長を出力 */
else
errchk(fprintf(pcdfile,"%c\n",ftypind)) ;
}
/************************************************/
/* convertint() : 必要ならばord命令を生成 */
/* boolean型か、列挙型でなく */
/* integer型に適合しなければ ord命令を生成 */
/************************************************/
void convertint(stp *fsp)
{
if(fsp == intptr) return ;
if((fsp->form == scalar) && (fsp->sf.sc.scalkind == declared)
&& (fsp != boolptr)) return ;
if(fsp->form == subrange) {
if(fsp->sf.su.rangetype == intptr) return ;
if((fsp->sf.su.rangetype->form == scalar) &&
(fsp->sf.su.rangetype->sf.sc.scalkind == declared)
&& (fsp->sf.su.rangetype != boolptr)) return ;
}
gen0t(iORD,fsp) ;
}
/************************************************/
/* load() : ロード関係の命令の出力 */
/************************************************/
void load(void)
{
char kind ;
if(!gattr.typtr) return ; /* 型がなければ何もしない */
switch(gattr.kind) { /* 種類で振り分ける */
case cst : /* 定数 */
if(gattr.typtr->form == scalar) {/* スカラー */
if(gattr.typtr == intptr) kind = 'i' ; /* 整数 */
else if(gattr.typtr == charptr) kind = 'c' ; /* 文字 */
else if(gattr.typtr == boolptr) kind = 'b' ; /* boolean */
else if(gattr.typtr == realptr) kind = 'r' ; /* 実数 */
else kind = 'i' ; /* 列挙型 */
}
else if(gattr.typtr == nilptr) kind = 'n' ; /* nil の時 */
else kind = 's' ; /* 集合型 */
genldc(kind,gattr.cval.ival) ; /* 'r','n','s' の時はival無効 */
break ;
case varbl : /* 変数 */
if(gattr.access == drct) /* 直接参照 */
if(gattr.vlevel <= 1) /* 大域変数(1),標準変数(0) */
gen1t(iLDO,gattr.typtr,gattr.dplmt) ;
else /* 局所変数 */
gen2t(iLOD,gattr.typtr,level-gattr.vlevel,gattr.dplmt) ;
else /* 間接参照 */
gen1t(iIND,gattr.typtr,gattr.idplmt) ;
break ;
/* case expr : */ /* 式の場合はすでに値がstackに*/
/* break ; */ /* 載っているので何もしない */
}
gattr.kind = expr ; /* これ以降は式の扱いのため
次回はloadが生成されない */
}
/****************************************************/
/* loadaddress() : アドレスロード関係命令の出力 */
/****************************************************/
void loadaddress(void)
{
if(!gattr.typtr) return ; /* 型がなければ何もしない */
switch(gattr.kind) { /* 種類で振り分ける */
case cst : /* 定数 */
if(string(gattr.typtr)) /* 文字列ならば */
genlca() ; /* lca命令出力 */
break ;
case varbl : /* 変数 */
if(gattr.access == drct) /* 直接参照 */
if(gattr.vlevel <= 1)
genq(iLAO,gattr.dplmt) ; /* lao命令の出力 */
else
genlda(level-gattr.vlevel,gattr.dplmt) ; /* lda命令の出力 */
else /* 間接参照(indrct) */
if(gattr.idplmt != 0)
gen1t(iINC,nilptr,gattr.idplmt) ; /* inc命令の出力 */
break ;
/* case expr :*/ /* 式 */
/* 本来はこのルートはない */
}
gattr.kind = varbl ;
gattr.access = indrct ;
gattr.idplmt = 0 ;
}
/******************************************/
/* store() : ストア関係命令の出力 */
/******************************************/
void store(attr fattr)
{
if(!gattr.typtr) return ; /* 型がなければ何もしない */
if(fattr.access == drct) /* 直接参照 */
if(fattr.vlevel <= 1) /* 大域変数(1) 標準変数(0) */
gen1t(iSRO,fattr.typtr,fattr.dplmt) ; /* sro命令 */
else /* 局所変数 */
gen2t(iSTR,fattr.typtr,level-fattr.vlevel,fattr.dplmt);/*str命令*/
else /* 間接参照 */
gen0t(iSTO,fattr.typtr) ; /* sto命令 */
/* fattr.idplmt != 0 のこと */
}
/****************************************/
/* genchk() : chk命令の出力 */
/* chk型 種別 下限 上限 */
/****************************************/
void genchk(stp *fsp, int kind, long min, long max)
{
if(!pcode) return ; /* 出力不要ならリターン */
putmnc(iCHK) ;
gentypindicator(fsp) ; /* 型の出力 */
errchk(fprintf(pcdfile," %2d %ld %ld\n", kind,min, max)) ;
}
/*************************************************/
/* checkbounds() : 上・下限のチェック命令の出力 */
/*************************************************/
void checkbounds(stp *fsp,int kind)
{
long lmin,lmax ;
if((!debug) || /* debugでない */
(!fsp) || /* 型がない */
(fsp == intptr) || /* 整数型 */
(fsp == charptr) || /* 文字型 */
(fsp == realptr) || /* 実数型 */
(fsp == boolptr)) return ; /* booleanならばチェック不要 */
/* スカラー,範囲型,集合型の時
しか、この処理は呼ばれない */
getbounds(fsp,&lmin,&lmax) ; /* その型の上限、下限を求める */
genchk(fsp,kind,lmin,lmax) ; /* chk命令生成 */
}